home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / dbmail.arc / ML0453.PRG < prev    next >
Text File  |  1988-06-18  |  4KB  |  199 lines
  1. NOTE ML0453 - ROUTINE TO DELETE USING INPUT BOOLEAN    9/24/84
  2. SET TALK OFF
  3. ERASE
  4. STORE     0 TO ZIPLO
  5. STORE 99999 TO ZIPHI
  6. STORE '.AND.OR. .NOT.'    TO LC
  7. STORE ".' "    TO DELM
  8.  
  9. @  7,10 SAY '     DELETE Selected Records by Logical (BOOLEAN) Criteria'
  10. @  9,10 SAY 'Input ZIP CODE Range   ' GET ZIPLO PICTURE '99999'
  11. @  9,41 SAY '   TO  ' GET ZIPHI PICTURE '99999'
  12. READ
  13. CLEAR GETS
  14.  
  15. STORE '                                                      ' TO INSTR
  16. STORE  F                     TO OK
  17. DO WHILE .NOT. OK
  18.     @ 14,0 SAY 'Input BOOLEAN criteria ' GET INSTR PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
  19.     READ
  20.     CLEAR GETS
  21.     @ 15,0
  22.     @ 17,0
  23.     @ 17,10 say 'Scanning BOOLEAN Criteria for Errors. Please Wait.'
  24.     @ 19,0
  25.     STORE TRIM(INSTR)    TO WS
  26.     STORE 1    TO N
  27.     STORE LEN(WS)+1    TO M
  28.     STORE WS+' '    TO WS
  29.     STORE 0    TO LO,PLOC,ECNT
  30.     STORE ' '    TO EC
  31.     STORE T    TO FRST
  32.     STORE F    TO NT,PLO
  33.  
  34.     DO WHILE N<M
  35.  
  36.     DO WHILE @( $(WS,N,1) ,DELM)>2 .AND.N<M
  37.     STORE N+1    TO N
  38.     ENDDO
  39.     STORE @( $(WS,N,1) ,DELM)    TO P
  40.      STORE N+1    TO L
  41.  
  42.     DO CASE
  43.     CASE N<M .AND. P=1
  44.         DO WHILE @( $(WS,L,1), DELM)#1 .AND.L<M
  45.         STORE L+1    TO L
  46.         ENDDO
  47.  
  48.         IF L=M
  49.             STORE '1'    TO EC
  50.         ELSE
  51.             STORE @( !($(WS,N,L-N+1)), LC)    TO LO
  52.             DO CASE
  53.             CASE LO=10
  54.                 IF PLO .OR. .NOT. NT
  55.                     STORE PLOC    TO LO
  56.                     STORE T    TO NT
  57.                 ELSE
  58.                     IF NT
  59.                         STORE '2'    TO EC
  60.                     ELSE
  61.                         STORE '3'    TO EC
  62.                         ENDIF
  63.                     ENDIF
  64.             CASE LO=1 .OR. LO=5
  65.                 IF PLO .OR. NT
  66.                     IF NT
  67.                         STORE '5'    TO EC
  68.                     ELSE
  69.                         STORE '4'    TO EC
  70.                         ENDIF
  71.                 ELSE
  72.                     STORE T    TO PLO
  73.                     STORE LO    TO PLOC
  74. note                  logical operator flag set to 1 or 5. No more processing needed
  75.                     ENDIF
  76.             OTHERWISE
  77.                 STORE '6'    TO EC
  78.             ENDCASE
  79.             ENDIF {n=m}
  80.  
  81.     CASE N<M .AND. P=2
  82.         DO WHILE @( $(WS,L,1), DELM)#P .AND. L<M
  83.         STORE L+1    TO L
  84.         ENDDO
  85.  
  86.         IF L=M
  87.             STORE '7'    TO EC
  88.         ELSE
  89. note                  following dbase practice, anything between delimiters is allowed
  90.             IF L-N=1
  91.                 STORE 'B'    TO EC
  92.             ELSE
  93.                 STORE "@('"+$(WS,N+1,L-N-1)+"',CODES)"    TO WA
  94.                 
  95.                 DO CASE
  96.                 CASE FRST.AND. LO=0
  97. NOTE                        don't need to add logical operator in front of criteria
  98.                 IF NT
  99.                     STORE WA+'=0'    TO WA
  100.                 ELSE
  101.                     STORE WA+'>0'    TO WA
  102.                     ENDIF
  103.     
  104.                 CASE FRST.AND. LO>0
  105.                     STORE '8'    TO EC
  106.     
  107.                 CASE .NOT.FRST.AND. LO=0
  108.                     STORE '9'    TO EC
  109.     
  110.                 CASE .NOT.FRST.AND. LO>0
  111.                     STORE $(LC,LO,5)+WA    TO WA
  112.                     IF NT
  113.                         STORE WA+'=0'    TO WA
  114.                     ELSE
  115.                         STORE WA+'>0'    TO WA
  116.                         ENDIF
  117.                 OTHERWISE
  118.                     STORE 'A'    TO EC
  119.                 ENDCASE
  120.                 IF FRST
  121.                     STORE WA    TO OS
  122.                     STORE F    TO FRST
  123.                 ELSE
  124.                     STORE OS+WA    TO OS
  125.                     ENDIF
  126.                 ENDIF {l-n=1}
  127.  
  128.             STORE 0    TO LO,PLOC
  129.             STORE F    TO NT,PLO
  130.             ENDIF {l=m}
  131.  
  132.     OTHERWISE
  133.         DO WHILE @( $(WS,L,1), DELM)=0 .AND. L<M
  134.         STORE L+1    TO L
  135.         ENDDO
  136.         STORE 'C'    TO EC
  137.         STORE L-1    TO L
  138.     ENDCASE
  139.  
  140.     IF EC#' '
  141.         STORE ECNT+1    TO ECNT
  142.         STORE STR(ECNT,1+INT(ECNT/10) )    TO EP
  143.         STORE EC    TO EC&EP
  144.         STORE N    TO BE&EP
  145.         STORE L    TO EE&EP
  146.         STORE ' '    TO EC
  147.         STORE 0    TO LO,PLOC
  148.         STORE F    TO NT,PLO
  149.         ENDIF
  150.  
  151.     STORE L+1    TO N
  152.     ENDDO {n<m}
  153.  
  154. IF ECNT>0
  155.     STORE 0    TO P
  156.     @ 15,10 SAY 'ERROR CODES:'
  157.     @ 17,2 SAY ECNT USING '99'
  158.     @ 17,5 SAY 'Errors found. Error codes appear underneath the string in error.'
  159.     DO WHILE P<ECNT
  160.     STORE P+1    TO P
  161.     STORE STR(P, 1+INT(P/10) )    TO EP
  162.     STORE BE&EP    TO N
  163.     STORE EE&EP+1    TO M
  164.     DO WHILE N<M
  165.     @ 15,23+N SAY EC&EP USING 'X'
  166.     STORE N+1    TO N
  167.     ENDDO
  168.     ENDDO
  169.     STORE 'Y'    TO EC
  170.     @ 19,10 SAY 'Correct and Retry? (Y/N) ' GET EC PICTURE '!'
  171.     READ
  172.     STORE EC#'Y'    TO OK
  173. ELSE
  174.     STORE T    TO OK
  175.     ENDIF
  176. ENDDO OK
  177.  
  178. IF ECNT=0
  179.     STORE '('+OS+')'    TO OS
  180.     STORE 'Y'    TO SEL
  181.     @ 17,10 SAY 'No Errors Found. Are you Sure you Wish to Continue? (Y/N) ' GET SEL PICTURE '!'
  182.     READ
  183.     IF SEL='Y'
  184.         SET TALK ON
  185.         DELETE ALL FOR &OS .AND. (VAL(ZIP)>=ZIPLO .AND. VAL(ZIP)<=ZIPHI)
  186.         SET TALK OFF
  187.         ENDIF
  188.     ENDIF
  189. RELEASE ZIPHI,ZIPLO,INSTR,OS,WS,WA,ECNT,EP,FRST,NT
  190. RELEASE OK,DELM,LC,LO,L,M,N,P,PLO,PLOC
  191. RELEASE EC,EC1,EC2,EC3,EC4,EC5,EC6,EC7,EC8,EC9,EC10,EC11,EC12,EC13,EC14,EC15,EC16,EC17,EC18,EC19
  192. RELEASE BE1,BE2,BE3,BE4,BE5,BE6,BE7,BE8,BE9,BE10,BE11,BE12,BE13,BE14,BE15,BE16,BE17,BE18,BE19
  193. RELEASE EE1,EE2,EE3,EE4,EE5,EE6,EE7,EE8,EE9,EE10,EE11,EE12,EE13,EE14,EE15,EE16,EE17,EE18,EE19
  194. USE
  195. RETURN
  196. E6,EE7,EE8,EE9,EE10,EE11,EE12,EE13,EE14,EE15,EE16,EE17,EE18,EE19
  197. USE
  198. RETURN
  199.